home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / 32kedit5 / 32kedit5.bas next >
BASIC Source File  |  1993-07-08  |  30KB  |  399 lines
  1. 10 'Ｇ３２ＫＥＤＩＴ　Ｖｅｒ　５．００　　１９９２年１２月１５日－
  2. 20 CLEAR ,,,,,300000:DEFINT A-Z:DEF FONT "システム   16ﾄﾞｯﾄ":SCREEN 1,1,3,1:SCREEN @0:MOUSE 0,1:CLS:VR$="５．２８Ｂ":V2$="１９９３年２月０８日"
  3. 30 C1=MOUSE(2,0)+MOUSE(2,1):LP=1:PA=1:C2C=0:PASTEL 128:CDC=0
  4. 40 LINE(100,100)-(540,380),PSET,7,BF:SYMBOL(150,120),"Ｇ３２ＫＥＤＩＴ",2,2,6,,,6:SYMBOL(180,160),"Ｖｅｒ　"+VR$,2,2,7,,,6:SYMBOL(120,200),"制作期間",2,2,6,,,6:SYMBOL(130,240),"１９９２年１２月１５日－",2,2,7,,,6
  5. 50 SYMBOL(200,280),V2$,2,2,7,,,6:CC=MOUSE(2,0)+MOUSE(2,1)
  6. 60 IF CC+C1<0 OR INKEY$<>"" THEN 80
  7. 70 MJC=0:ON ERROR GOTO *ERR:DEF FONT "システム   12ﾄﾞｯﾄ":MJC=1:ON ERROR GOTO 0
  8. 80 FOR A=0 TO 220:LINE(100+A,100+A)-(540-A,380-A),PSET,0,B:NEXT:SCREEN 1,0:SCREEN @1:WINDOW(0,0)-(319,239):VIEW(0,0)-(319,239)
  9. 90 SCREEN 1,1:SCREEN @1:WINDOW(0,0)-(319,239):VIEW(0,0)-(319,239)
  10. 100 DIM CO(2,2),WX(9),WY(9),W2X(9),W2Y(9),WC(9),PIC(76800),OP(9):LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:MOUSE 1,120,160,1:FOR A=0 TO 2:CO(0,A)=255:NEXT
  11. 110 IF FRE(4)<56000 THEN JP=1 ELSE JP=0
  12. 120 FOR A=0 TO 7:READ OP(A):NEXT:SI=OP(0)
  13. 130 DATA 16,128,0,0,0,0,16,15
  14. 140 GOSUB *W1:GOTO *MAIN
  15. 150 *ERR
  16. 160 MJC=0:RESUME 80
  17. 170 *G1
  18. 180 FOR G=8 TO 0 STEP -1:WC(G+1)=WC(G):WX(G+1)=WX(G):WY(G+1)=WY(G):W2X(G+1)=W2X(G):W2Y(G+1)=W2Y(G):NEXT
  19. 190 FOR G=0 TO 8:IF WC(G)=CC THEN FOR G1=G TO 8:WC(G1)=WC(G1+1):WX(G1)=WX(G1+1):WY(G1)=WY(G1+1):W2X(G1)=W2X(G1+1):W2Y(G1)=W2Y(G1+1):NEXT:WC(G1)=0
  20. 200 NEXT:IF WC(G)=CC THEN WC(GG)=0
  21. 210 WC(0)=CC:WC=0:RETURN
  22. 220 *G2
  23. 230 MOUSE 1,,,0:IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):WC=0:GOSUB *表示
  24. 240 SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1),PIC:SCREEN 1,1:PUT@A(WX(WC)+9,WY(WC)+20)-(WX(WC)+8+LP*16,WY(WC)+19+LP*16),PIC,,6/LP,6/LP:LINE(WX(WC)+1,WY(WC)+12)-(WX(WC)+50,WY(WC)+19),PSET,7,BF
  25. 250 IF LL=2 THEN FOR GG=1 TO LP*16:LINE(WX(WC)+9,WY(WC)+20+6/LP*GG)-(WX(WC)+104,WY(WC)+20+6/LP*GG),PSET,[0,0,96]:LINE(WX(WC)+9+6/LP*GG,WY(WC)+20)-(WX(WC)+9+6/LP*GG,WY(WC)+115),PSET,[0,0,96]:NEXT
  26. 260 IF LL>0 THEN FOR GG=1 TO LP*2-1:LINE(WX(WC)+9,WY(WC)+20+GG*48/LP)-(WX(WC)+104,WY(WC)+20+48/LP*GG),PSET,[128,128,128],,&HAAAA:LINE(WX(WC)+9+48/LP*GG,WY(WC)+20)-(WX(WC)+9+GG*48/LP,WY(WC)+115),PSET,[128,128,128],,&HAAAA:NEXT
  27. 270 SYMBOL(WX(WC)+1,WY(WC)+12),STR$(C1X)+","+STR$(C1Y),.5!,.5!,0:MOUSE 1,,,1:RETURN *MAIN
  28. 280 *表示
  29. 290 SCREEN 1,1:MOUSE 1,,,0:LINE(0,16)-(319,239),PSET,[0,0,0,1],BF:FOR G=9 TO 0 STEP -1:IF WC(G)>0 THEN WC=G:ON WC(G) GOSUB *E1,*E2,*E3,*E4,*E5
  30. 300 NEXT:MOUSE 1,,,1:RETURN
  31. 310 *W1
  32. 320 MOUSE 1,,,0:SCREEN 1,1:LINE(0,0)-(319,15),PSET,[64,64,64],BF,7:LINE(1,1)-(49,14),PSET,[96,96,96],BF:SYMBOL(1,1),"32KEDIT",.75!,.75!,0
  33. 330 FOR G=0 TO 4:SYMBOL(50+G*48,1),KMID$("ファイル ルーペ カラー 編集  その他",G*4+1,4),.75!,.75!,0:LINE(50+G*48,0)-(98+G*48,15),PSET,[64,64,64],B:NEXT:LINE(291,1)-(319,14),PSET,[96,96,96],BF:SYMBOL(292,1),"全終",.75!,.75!,0
  34. 340 MOUSE 1,,,1:RETURN
  35. 350 *E1
  36. 360 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+113,CY+148),PSET,0,BF,7:SYMBOL(CX+14,CY+1),"ルーペ",.75!,.75!,0:SYMBOL(CX+1,CY+70),"←",.5!,.5!,0:SYMBOL(CX+53,CY+12),"↑",.5!,.5!,0:SYMBOL(CX+103,CY+69),"→",.5!,.5!,0:SYMBOL(CX+53,CY+116),"↓",.5!,.5!,0
  37. 370 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[64,64,64],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0:SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1),PIC:SCREEN 1,1:PUT@A(CX+9,CY+20)-(CX+8+LP*16,CY+19+LP*16),PIC,,6/LP,6/LP
  38. 380 IF WC=0 THEN FOR GG=0 TO 4:LINE(CX+41+GG*12,CY+136)-(CX+52+GG*12,CY+147),PSET,[255-GG*32,GG*32+80,GG*32],BF:NEXT
  39. 390 SYMBOL(CX+5,CY+124),"×６ ×３ ×２ Ｌ",.75!,.75!,0:SYMBOL(CX+5,CY+136),"複塗潰点線丸透調",.75!,.75!,0:LINE(WX(WC)+1,WY(WC)+12)-(WX(WC)+50,WY(WC)+19),PSET,7,BF:SYMBOL(WX(WC)+1,WY(WC)+12),STR$(C1X)+","+STR$(C1Y),.5!,.5!,0
  40. 400 IF LL=2 AND WC=0 THEN FOR GG=1 TO LP*16-1:LINE(WX(WC)+9,WY(WC)+20+6/LP*GG)-(WX(WC)+104,WY(WC)+20+6/LP*GG),PSET,[0,0,96]:LINE(WX(WC)+9+6/LP*GG,WY(WC)+20)-(WX(WC)+9+6/LP*GG,WY(WC)+115),PSET,[0,0,96]:NEXT
  41. 410 IF LL>0 AND WC=0 THEN FOR GG=1 TO LP*2-1:LINE(WX(WC)+9,WY(WC)+20+GG*48/LP)-(WX(WC)+104,WY(WC)+20+48/LP*GG),PSET,[128,128,128],,&HAAAA:LINE(WX(WC)+9+48/LP*GG,WY(WC)+20)-(WX(WC)+9+GG*48/LP,WY(WC)+115),PSET,[128,128,128],,&HAAAA:NEXT
  42. 420 LINE(CX+29+PA*12,CY+136)-(CX+40+PA*12,CY+147),XOR,7,BF
  43. 430 RETURN
  44. 440 *E2
  45. 450 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+93,CY+55),PSET,0,BF,7:SYMBOL(CX+14,CY+1),"カラー",.75!,.75!,0
  46. 460 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[64,64,64],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  47. 470 FOR A=0 TO 2:LINE(CX+4+A*30,CY+14)-(CX+30+A*30,CY+22),PSET,0,BF,[CO(A,0),CO(A,1),CO(A,2)]:NEXT:FOR A=0 TO 2:LINE(CX+2,CY+24+A*10)-(CX+91,CY+32+A*10),PSET,0,BF,3-A-(A=0):NEXT
  48. 480 FOR A=0 TO 2:LINE(CX+2+CO(2,A)/3,CY+24+A*10)-(CX+5+CO(2,A)/3,CY+32+A*10),PSET,7,B:NEXT:RETURN
  49. 490 *E3
  50. 500 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+79,CY+73),PSET,0,BF,7:SYMBOL(CX+14,CY+1),"ファイル",.75!,.75!,0
  51. 510 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[64,64,64],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  52. 520 SYMBOL(CX+1,CY+12),"LOAD",.75!,.75!,0:SYMBOL(CX+1,CY+24),"SAVE",.75!,.75!,0:SYMBOL(CX+1,CY+36),"圧縮SAVE",.75!,.75!,0:SYMBOL(CX+1,CY+48),"JPEG SAVE",.75!,.75!,0:SYMBOL(CX+1,CY+60),"JPEG LOAD",.75!,.75!,0
  53. 530 RETURN
  54. 540 *E4
  55. 550 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+79,CY+63),PSET,0,BF,7:SYMBOL(CX+14,CY+1),"その他",.75!,.75!,0
  56. 560 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[64,64,64],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  57. 570 SYMBOL(CX+1,CY+12),"新規作成",.75!,.75!,0:SYMBOL(CX+1,CY+24),"ＣＤ演奏",.75!,.75!,0:SYMBOL(CX+1,CY+36),"オプション",.75!,.75!,0:SYMBOL(CX+1,CY+48),"ｱﾆﾒｰｼｮﾝ",.75!,.75!,0
  58. 580 RETURN
  59. 590 *E5
  60. 600 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+79,CY+191),PSET,0,BF,7:SYMBOL(CX+14,CY+1),"編集",.75!,.75!,0
  61. 610 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[64,64,64],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  62. 620 C$="複写    左色除き複写塗り潰し  範囲塗り潰し四角を描く 円を描く  塗り潰し円 絵の反転  絵の拡大  色入替え  字を書く  明るさ変える霧拭き   混合塗り潰しスプライト "
  63. 630 FOR A=0 TO 14:SYMBOL(CX+1,CY+12+A*12),KMID$(C$,1+A*6,6),.75!,.75!,0:NEXT:RETURN
  64. 640 'ファイル
  65. 650 CC=3:GOSUB *G1:WX(0)=50:WY(0)=20:W2X(0)=80:W2Y(0)=74:GOSUB *E3:GOTO *MAIN
  66. 660 GOTO *MAIN
  67. 670 'ルーペ
  68. 680 SCREEN 1,1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:WAIT 20:SCREEN 1,0
  69. 690 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(CX+LP*16-1,CY+LP*16-1),XOR,7,B:LINE(CX,CY)-(CX+LP*16-1,CY+LP*16-1),XOR,7,B
  70. 700 IF MOUSE(2,0)=0 THEN 690
  71. 710 C1X=CX:C1Y=CY:CC=1:GOSUB *G1:WX(0)=100:WY(0)=81:W2X(0)=114:W2Y(0)=148:GOSUB *W1:GOSUB *表示:GOTO *MAIN
  72. 720 'カラー
  73. 730 CC=2:GOSUB *G1:WX(0)=99:WY(0)=20:W2X(0)=94:W2Y(0)=56:GOSUB *E2:GOTO *MAIN
  74. 740 '編集
  75. 750 CC=5:GOSUB *G1:WX(0)=200:WY(0)=20:W2X(0)=80:W2Y(0)=192:GOSUB *E5:GOTO *MAIN
  76. 760 'その他
  77. 770 CC=4:GOSUB *G1:WX(0)=240:WY(0)=40:W2X(0)=80:W2Y(0)=64:GOSUB *E4:GOTO *MAIN
  78. 780 *YN
  79. 790 SCREEN 1,1:LINE(50,99)-(270,139),PSET,0,BF,7:SYMBOL(52,101),SE$,.75!,.75!,0:LINE(190,120)-(220,135),PSET,0,BF,7:LINE(230,120)-(260,135),PSET,0,BF,7:SYMBOL(191,121),"実行",.75!,.75!,0:SYMBOL(231,121),"取消",.75!,.75!,0:MOUSE 4,51,99,271,139
  80. 800 CX=MOUSE(0)-190:CY=MOUSE(1)-120:IF MOUSE(2,0)=0 THEN 800
  81. 810 IF CX>0 AND CX<68 AND CY>0 AND CY<15 THEN MOUSE 4,0,0,319,239:QC=INT(CX/35):RETURN ELSE 800
  82. 820 *MAIN
  83. 830 SCREEN 1,1
  84. 840 CX=MOUSE(0):CY=MOUSE(1)
  85. 850 IF MOUSE(2,0)=-1 THEN C1=0:GOTO 870 ELSE IF MOUSE(2,1)=-1 THEN C1=1:GOTO 870
  86. 860 C2C=0:GOTO 840
  87. 870 IF CY<16 AND CX>50 AND CY<289 THEN ON INT((CX-50)/48)+1 GOTO 650,670,720,750,770
  88. 880 IF CY<16 AND CX>290 AND CX<305 THEN 
  89. 890 SCREEN 1,1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF
  90. 900 IF MOUSE(2,0)=-1 OR MOUSE(2,1)=-1 THEN 900
  91. 910 GOSUB *W1:GOSUB *表示:GOTO *MAIN
  92. 920 ENDIF
  93. 930 IF CY<16 AND CX>304 THEN SE$="Ｇ３２ＫＥＤＩＴを終了します":GOSUB *YN:IF QC=0 THEN END ELSE GOSUB *表示:GOTO *MAIN
  94. 940 WC=0
  95. 950 IF WX(WC)<CX AND WX(WC)+W2X(WC)>CX AND WY(WC)<CY AND WY(WC)+W2Y(WC)>CY THEN *WINDOW
  96. 960 WC=WC+1:IF WC<10 THEN 950
  97. 970 GOTO 840
  98. 980 *WINDOW
  99. 990 IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):WC=0
  100. 1000 CCX=CX-WX(WC):CCY=CY-WY(WC):IF CCY>12 THEN 1080
  101. 1010 IF CCX<12 THEN FOR G=1 TO 9:WC(G-1)=WC(G):WX(G-1)=WX(G):WY(G-1)=WY(G):W2X(G-1)=W2X(G):W2Y(G-1)=W2Y(G):NEXT:GOSUB *表示:GOTO *MAIN
  102. 1020 GOTO 1030:SCREEN 1,1:LINE(0,16)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0
  103. 1030 CX=MOUSE(0)-CCX:CY=MOUSE(1)-CCY:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT
  104. 1040 IF MOUSE(2,C1)=-1 THEN 1030 
  105. 1050 IF CX<0 THEN CX=0 ELSE IF CX+W2X(0)>319 THEN CX=319-W2X(0)
  106. 1060 IF CY<17 THEN CY=17 ELSE IF CY+W2Y(0)>239 THEN CY=239-W2Y(0)
  107. 1070 WX(0)=CX:WY(0)=CY:GOSUB *表示:GOTO *MAIN
  108. 1080 ON WC(WC) GOTO *ルーペ,*カラー,*ファイル,*その他,*編集
  109. 1090 GOTO *MAIN
  110. 1100 *ルーペ
  111. 1110 CC=6/LP:IF CCX>8 AND CCY>19 AND CCX<105 AND CCY<116 THEN 
  112. 1120 SCREEN 1,0:Y1=CO(C1,0):Y2=CO(C1,1):Y3=CO(C1,2):CX=INT((CCX-9)/6*LP):CY=INT((CCY-20)/6*LP):IF PA=1 OR PA=3 THEN PSET(C1X+CX,C1Y+CY),[Y1,Y2,Y3]
  113. 1130 IF PA=5 THEN 
  114. 1140 CX=C1X+CX:CY=C1Y+CY:C3=PEEK([&H1C]CX*2+CY*1024):C2=PEEK([&H1C]CX*2+CY*1024+1):B=INT(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT((INT(C2 AND 3)*64+INT(C3/8)*2)/8)*8:CO(C1,0)=G:CO(C1,1)=R:CO(C1,2)=B
  115. 1150 SCREEN 1,1:CC=-1:FOR B=0 TO 9:IF WC(B)=2 THEN CC=B
  116. 1160 NEXT:IF CC=-1 THEN *MAIN
  117. 1170 IF CC=0 THEN 1210
  118. 1180 C2=1:C3=1:CX=WX(CC)+4+C1*30:CY=WY(CC)+14:FOR B=0 TO CC-1:IF WX(B)<CX AND WY(B)<CY AND WX(B)+W2X(B)>CX+26 AND WY(B)+W2Y(B)>CY+8 THEN C2=0:B=9
  119. 1190 IF C2=1 AND WY(B)+W2Y(B)>CY+55 THEN FOR A=0 TO 2:LINE(WX(CC)+2+CO(2,A)/3,WY(CC)+24+A*10)-(WX(CC)+5+CO(2,A)/3,WY(CC)+32+A*10),PSET,7,B:NEXT
  120. 1200 NEXT:IF C2=0 THEN *MAIN
  121. 1210 LINE(WX(CC)+4+C1*30,WY(CC)+14)-(WX(CC)+30+C1*30,WY(CC)+22),PSET,0,BF,[CO(C1,0),CO(C1,1),CO(C1,2)]:GOTO *MAIN
  122. 1220 ENDIF
  123. 1230 IF PA=4 THEN PSET(C1X+CX,C1Y+CY),[Y1,Y2,Y3],PASTEL
  124. 1240 IF C2C=0 THEN C2X=CX+C1X:C2Y=CY+C1Y:C2C=1
  125. 1250 IF PA=2 THEN LINE(C2X,C2Y)-(C1X+CX,C1Y+CY),PSET,[Y1,Y2,Y3]:C2X=C1X+CX:C2Y=C1Y+CY
  126. 1260 IF PA=3 THEN 
  127. 1270 PSET(C1X+CX-1,C1Y+CY),[Y1,Y2,Y3],PASTEL:PSET(C1X+CX+1,C1Y+CY),[Y1,Y2,Y3],PASTEL:PSET(C1X+CX,C1Y+CY-1),[Y1,Y2,Y3],PASTEL:PSET(C1X+CX,C1Y+CY+1),[Y1,Y2,Y3],PASTEL
  128. 1280 SCREEN 1,1:WINDOW(WX(WC)+9,WY(WC)+20)-(WX(WC)+104,WY(WC)+115):VIEW(WX(WC)+9,WY(WC)+20)-(WX(WC)+104,WY(WC)+115):LINE(WX(WC)+CX*CC-CC+9,WY(WC)+CY*CC+20)-(WX(WC)+CX*CC+8,WY(WC)+CY*CC+CC+19),PASTEL,[Y1,Y2,Y3],BF
  129. 1290 LINE(WX(WC)+CX*CC+CC+9,WY(WC)+CY*CC+20)-(WX(WC)+CX*CC+CC*2+8,WY(WC)+CY*CC+CC+19),PASTEL,[Y1,Y2,Y3],BF:LINE(WX(WC)+CX*CC+9,WY(WC)+CY*CC-CC+20)-(WX(WC)+CX*CC+CC+8,WY(WC)+CY*CC+19),PASTEL,[Y1,Y2,Y3],BF
  130. 1300 LINE(WX(WC)+CX*CC+9,WY(WC)+CY*CC+20+CC)-(WX(WC)+CX*CC+CC+8,WY(WC)+CY*CC+CC*2+19),PASTEL,[Y1,Y2,Y3],BF:WINDOW(0,0)-(319,239):VIEW(0,0)-(319,239)
  131. 1310 ENDIF
  132. 1320 SCREEN 1,1:IF PA=1 OR PA=3 THEN LINE(WX(WC)+9+CX*CC,WY(WC)+20+CY*CC)-(WX(WC)+8+CX*CC+CC,WY(WC)+19+CY*CC+CC),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO *MAIN
  133. 1330 IF PA=4 THEN LINE(WX(WC)+9+CX*CC,WY(WC)+20+CY*CC)-(WX(WC)+8+CX*CC+CC,WY(WC)+19+CY*CC+CC),PASTEL,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO *MAIN
  134. 1340 IF PA=2 THEN GOSUB *G2
  135. 1350 ELSE
  136. 1360 IF CCX>5 AND CCY>124 AND CCX<95 AND CCY<135 THEN LP=INT((CCX-5)/30)+1:C1Y=-(C1Y<240-LP*16)*C1Y-(C1Y>239-LP*16)*(240-LP*16):C1X=-(C1X<320-LP*16)*C1X-(C1X>319-LP*16)*(320-LP*16):GOSUB *表示:GOTO *MAIN
  137. 1370 IF CCX>95 AND CCX<125 AND CCY>124 AND CCY<135 THEN LL=LL+1:LL=-(LL<3)*LL:GOSUB *G2
  138. 1380 IF CCX>43 AND CCY>12 AND CCX<71 AND CCY<24 THEN C1Y=C1Y-LP*4:C1Y=-(C1Y>0)*C1Y:GOSUB *G2
  139. 1390 IF CCX<9 AND CCY>60 AND CCY<88 THEN C1X=C1X-LP*4:C1X=-(C1X>0)*C1X:GOSUB *G2
  140. 1400 IF CCX>43 AND CCY>116 AND CCX<71 AND CCY<124 THEN C1Y=C1Y+LP*4:C1Y=-(C1Y<240-LP*16)*C1Y-(C1Y>239-LP*16)*(240-LP*16):GOSUB *G2
  141. 1410 IF CCY>60 AND CCY<88 AND CCX>106 AND CCX<114 THEN C1X=C1X+LP*4:C1X=-(C1X<320-LP*16)*C1X-(C1X>319-LP*16)*(320-LP*16):GOSUB *G2
  142. 1420 ENDIF
  143. 1430 IF CCX>5 AND CCY>136 AND CCY<148 AND CCX<101 THEN 
  144. 1440 CCX=INT((CCX-5)/12)+1:IF CCX>3 THEN LINE(WX(WC)+29+PA*12,WY(WC)+136)-(WX(WC)+40+PA*12,WY(WC)+147),XOR,7,BF:PA=INT(CCX-3):LINE(WX(WC)+29+PA*12,WY(WC)+136)-(WX(WC)+40+PA*12,WY(WC)+147),XOR,7,BF:GOTO *MAIN
  145. 1450 MOUSE 4,WX(WC)+9,WY(WC)+20,WX(WC)+104,WY(WC)+115:WAIT 20:SCREEN 1,1
  146. 1460 CX=INT((MOUSE(0)-WX(WC)-9)/6*LP):CY=INT((MOUSE(1)-WY(WC)-20)/6*LP)
  147. 1470 LINE(WX(WC)+9+CX*CC,WY(WC)+20+CY*CC)-(WX(WC)+8+CX*CC+CC,WY(WC)+19+CY*CC+CC),XOR,7,B:WAIT 2:LINE(WX(WC)+9+CX*CC,WY(WC)+20+CY*CC)-(WX(WC)+8+CX*CC+CC,WY(WC)+19+CY*CC+CC),XOR,7,B
  148. 1480 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOTO *MAIN
  149. 1490 IF MOUSE(2,0)=0 THEN 1460
  150. 1500 IF CCX=2 THEN SCREEN 1,0:WINDOW(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1):VIEW(C1X,C1Y)-(C1X+LP*16-1,C1Y+LP*16-1):PAINT@(C1X+CX,C1Y+CY),[CO(C1,0),CO(C1,1),CO(C1,2)]:WINDOW(0,0)-(319,239):VIEW(0,0)-(319,239):MOUSE 4,0,0,319,239:GOSUB *G2
  151. 1510 QC=CCX:CCX=CX:CCY=CY:WAIT 20
  152. 1520 CX=INT((MOUSE(0)-WX(WC)-9)/6*LP):CY=INT((MOUSE(1)-WY(WC)-20)/6*LP)
  153. 1530 LINE(WX(WC)+9+CCX*CC+CC/2,WY(WC)+20+CCY*CC+CC/2)-(WX(WC)+9+CX*CC+CC/2,WY(WC)+20+CY*CC+CC/2),XOR,7,B:WAIT 2:LINE(WX(WC)+9+CCX*CC+CC/2,WY(WC)+20+CCY*CC+CC/2)-(WX(WC)+9+CX*CC+CC/2,WY(WC)+20+CY*CC+CC/2),XOR,7,B
  154. 1540 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOTO *MAIN
  155. 1550 IF MOUSE(2,0)=0 THEN 1520
  156. 1560 SCREEN 1,0:IF QC=3 THEN LINE(C1X+CCX,C1Y+CCY)-(C1X+CX,C1Y+CY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:MOUSE 4,0,0,319,239:GOSUB *G2
  157. 1570 GET@A(C1X+CCX,C1Y+CCY)-(C1X+CX,C1Y+CY),PIC:SCREEN 1,1:CCX=ABS(CX-CCX):CCY=ABS(CY-CCY)
  158. 1580 CX=INT((MOUSE(0)-WX(WC)-9)/CC):CY=INT((MOUSE(1)-WY(WC)-20)/CC):PUT@A(WX(WC)+CX*CC+9,WY(WC)+CY*CC+20)-(9+WX(WC)+CX*CC+CCX,20+WY(WC)+CY*CC+CCY),PIC,XOR,CC,CC:PUT@A(9+WX(WC)+CX*CC,20+WY(WC)+CY*CC)-(9+WX(WC)+CX*CC+CCX,20+WY(WC)+CY*CC+CCY),PIC,XOR,CC,CC
  159. 1590 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,319,239:GOTO *MAIN
  160. 1600 IF MOUSE(2,0)=0 THEN 1580
  161. 1610 MOUSE 4,0,0,319,239:SCREEN 1,0:PUT@A(C1X+CX,C1Y+CY)-(C1X+CX+CCX,C1Y+CCY+CY),PIC:GOSUB *G2:GOTO *MAIN
  162. 1620 ENDIF
  163. 1630 GOTO *MAIN
  164. 1640 *カラー
  165. 1650 IF CCX>2 AND CCY>24 AND CCY<53 THEN CX=INT((CCX-3)/3)*9:CY=INT((CCY-24)/10) ELSE 1690
  166. 1660 IF CX>255 THEN CX=255
  167. 1670 CO(2,CY)=CX:LINE(WX(WC)+64,WY(WC)+14)-(WX(WC)+90,WY(WC)+22),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(WC)+2,WY(WC)+24+A*10)-(WX(WC)+91,WY(WC)+32+A*10),PSET,0,BF,3-A-(A=0):NEXT
  168. 1680 FOR A=0 TO 2:LINE(WX(WC)+2+CO(2,A)/3,WY(WC)+24+A*10)-(WX(WC)+5+CO(2,A)/3,WY(WC)+32+A*10),PSET,7,B:NEXT:GOTO *MAIN
  169. 1690 IF CCY>14 AND CCY<20 THEN 
  170. 1700 IF CCX>68 AND CCX<96 THEN 
  171. 1710 FOR A=0 TO 2:LINE(WX(WC)+2,WY(WC)+24+A*10)-(WX(WC)+91,WY(WC)+32+A*10),PSET,0,BF,3-A-(A=0):NEXT
  172. 1720 CO(2,0)=CO(C1,0):CO(2,1)=CO(C1,1):CO(2,2)=CO(C1,2):LINE(WX(WC)+64,WY(WC)+14)-(WX(WC)+90,WY(WC)+22),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(WC)+2+CO(2,A)/3,WY(WC)+24+A*10)-(WX(WC)+5+CO(2,A)/3,WY(WC)+32+A*10),PSET,7,B:NEXT:GOTO *MAIN
  173. 1730 ENDIF
  174. 1740 IF CCX>4 AND CCX<30 THEN CO(0,0)=CO(2,0):CO(0,1)=CO(2,1):CO(0,2)=CO(2,2):LINE(WX(WC)+4,WY(WC)+14)-(WX(WC)+30,WY(WC)+22),PSET,0,BF,[CO(0,0),CO(0,1),CO(0,2)]
  175. 1750 IF CCX>34 AND CCX<60 THEN CO(1,0)=CO(2,0):CO(1,1)=CO(2,1):CO(1,2)=CO(2,2):LINE(WX(WC)+34,WY(WC)+14)-(WX(WC)+60,WY(WC)+22),PSET,0,BF,[CO(1,0),CO(1,1),CO(1,2)]
  176. 1760 ENDIF
  177. 1770 GOTO *MAIN
  178. 1780 *ファイル
  179. 1790 CCY=INT((CCY-12)/12)+1:SCREEN 1,0:GET@A(0,0)-(319,239),PIC:CLS
  180. 1800 IF CCY=3 AND JP=1 THEN MOUSE 1,,,0:SCREEN 0:BEEP:SYMBOL(0,0),"メモリが足りません｡他のＳＡＶＥを使用してください｡",.75!,.75!,2:Q$=INPUT$(1):GOTO 2080
  181. 1810 MOUSE 1,,,0:SCREEN 0:CONSOLE 0,24,2:PRINT "ドライブ名?";:A$=INPUT$(1):IF A$=CHR$(13) THEN 2080
  182. 1820 CC=ASC(A$):IF CC>96 THEN CC=CC-32:A$=CHR$(CC)
  183. 1830 IF A$="Q" AND CCY>1 THEN PRINT "Ｑドライブには書き込めません":GOTO 1810
  184. 1840 PRINT A$:IF CC<65 OR CC>81 THEN 1810
  185. 1850 PRINT KMID$("     LOAD     SAVE   圧縮SAVEJPEGSAVE",CCY*9-8,9)
  186. 1860 ON ERROR GOTO *ER1:SHELL A$+":":FILES"*.*"
  187. 1870 IF MEM$<>"" THEN PRINT "前回入力したファイル名　";MEM$
  188. 1880 LINE INPUT "ﾌｧｲﾙ or 命令？　";F$:IF LEFT$(F$,2)="CD" THEN SHELL F$:GOTO 1860
  189. 1890 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 1860
  190. 1900 IF F$="" THEN 2080
  191. 1910 IF CCY=4 THEN
  192. 1920 INPUT "圧縮比率(1 OR 2 OR 4)";Y1:IF Y1<>1 AND Y1<>2 AND Y1<>4 THEN 1920
  193. 1930 INPUT "輝度成分(0-100)";Y2:IF Y2<0 OR Y2>100 THEN 1930
  194. 1940 INPUT "色成分  (0-100)";Y3:IF Y3<0 OR Y3>100 THEN 1940
  195. 1950 ENDIF
  196. 1960 SCREEN 1,1:SCREEN @1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0:MOUSE 0,1:MOUSE 1,200,100,1
  197. 1970 MEM$=F$:PUT@A(0,0)-(319,239),PIC:SCREEN 1,0:ON ERROR GOTO *ER2:IF CCY>1 AND CCY<5 THEN 2020
  198. 1980 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(319,239),XOR,7,B:LINE(CX,CY)-(319,239),XOR,7,B:IF MOUSE(2,1)=-1 THEN 2080
  199. 1990 IF MOUSE(2,0)=0 THEN 1980
  200. 2000 IF CCY=5 THEN LOAD@ F$+".JPG",(CX,CY):GET@A(0,0)-(319,239),PIC:GOTO 2080
  201. 2010 SCREEN 1,0:LOAD@ F$+".TIF",(CX,CY):GET@A(0,0)-(319,239),PIC:GOTO 2080
  202. 2020 CX=INT((MOUSE(0)+1)/SI)*SI-1:CY=INT((MOUSE(1)+1)/SI)*SI-1:LINE(0,0)-(CX,CY),XOR,7,B:LINE(0,0)-(CX,CY),XOR,7,B
  203. 2030 IF MOUSE(2,1)=-1 THEN 2080
  204. 2040 IF MOUSE(2,0)=0 THEN 2020
  205. 2050 IF CCY=3 THEN 2090
  206. 2060 IF CCY=4 THEN 2100
  207. 2070 SCREEN 1,0:C$=".TIF":SAVE@ A$+":"+F$+".TIF",(0,0)-(CX,CY):GOTO 2080
  208. 2080 SCREEN 1,0:ON ERROR GOTO 0:PUT@A(0,0)-(319,239),PIC:SCREEN 1,1:SCREEN @1:MOUSE 0,1:MOUSE 1,100,100,1:GOSUB *W1:GOSUB *表示:GOTO *MAIN
  209. 2090 SCREEN 1,0:C$=".TIF":SAVE@ A$+":"+F$+".TIF",(0,0)-(CX,CY),,1:GOTO 2080
  210. 2100 SCREEN 1,0:C$=".JPG":SAVE@ A$+":"+F$+".JPG",(0,0)-(CX,CY),,2,Y1,Y2,Y3:GOTO 2080
  211. 2110 *ER1
  212. 2120 BEEP:PRINT "指定のファイル 又は ドライブが存在しません｡":Q$=INPUT$(1):RESUME 1810
  213. 2130 *ER2
  214. 2140 MOUSE 1,,,0:SCREEN 0:CONSOLE 0,24,2:CLS:BEEP:IF ERR=63 THEN PRINT "指定のファイルが見つかりません":RESUME 1860
  215. 2150 IF ERR=64 THEN
  216. 2160 PRINT "指定のファイルは存在しています｡":PRINT "1)続行する 2)その絵を見る 3)中止する":Q$=INPUT$(1):CLS
  217. 2170 IF Q$="1" THEN PUT@A(0,0)-(319,239),PIC:KILL A$+":"+F$+C$:RESUME
  218. 2180 IF Q$="2" THEN LOAD@ A$+":"+F$+C$:Q$=INPUT$(1):CLS:GOTO 2160 ELSE RESUME 2080
  219. 2190 ENDIF
  220. 2200 IF ERR=60 OR ERR=53 OR ERR=72 THEN PRINT "ディスクを正しくセットして下さい":Q$=INPUT$(1):RESUME 1810
  221. 2210 IF ERR=55 THEN PRINT "正しくファイル名を指定してください｡":RESUME 1860 
  222. 2220 IF ERR=112 THEN PRINT "このファイルは このツールでは読み込めません｡":Q$=INPUT$(1):RESUME 1810
  223. 2230 IF ERR=73 THEN PRINT "ディスクの書き込みが禁止されています｡":RESUME 1860
  224. 2240 IF ERR=75 THEN PRINT "アクセスが拒否されました｡":RESUME 1860
  225. 2250 IF ERR=28 THEN PRINT "サイドワークを設定しないとＪＰＥＧ形式は使えません｡":Q$=INPUT$(1):RESUME 1810
  226. 2260 IF ERR=89 THEN PRINT "システム用作業領域が一杯になりました｡":PRINT "サイドワークを外してください｡":Q$=INPUT$(1):RESUME 1810
  227. 2270 IF ERR=67 THEN PRINT "ディスクの容量が足りません｡":Q$=INPUT$(1):RESUME 1810
  228. 2280 PRINT "エラー番号";ERR;"のエラーが";ERL;"行で発生しました｡":Q$=INPUT$(1):RESUME 1810
  229. 2290 *その他
  230. 2300 CCY=INT((CCY-12)/12)+1:ON CCY GOTO 2310,2340,2360,*アニメ
  231. 2310 BEEP:SE$="絵を消していいですか｡":GOSUB *YN:IF QC=1 THEN 2330
  232. 2320 SE$="絵は保存されません｡":BEEP:GOSUB *YN:IF QC=0 THEN SCREEN 1,0:CLS
  233. 2330 GOSUB *表示:GOTO *MAIN
  234. 2340 ON ERROR GOTO *ERRCD:CDC=1-CDC:IF CDC=1 THEN CD PLAY ELSE CD STOP
  235. 2350 ON ERROR GOTO 0:GOTO *MAIN
  236. 2360 LINE(50,20)-(270,132),PSET,0,BF,7:MOUSE 4,50,20,270,132:SYMBOL(64,21),"オプション",.75!,.75!,0:LINE(51,21)-(61,31),PSET,[64,64,64],BF:LINE(51,21)-(61,31),PSET,0
  237. 2370 SYMBOL(51,35),"範囲指定のサイズ",.75!,.75!,0:SYMBOL(51,47),"混合比率",.75!,.75!,0:SYMBOL(51,59),"色入替えの許容差　緑",.75!,.75!,0:SYMBOL(159,71),"赤",.75!,.75!,0:SYMBOL(159,83),"青",.75!,.75!,0
  238. 2380 SYMBOL(51,95),"色入替え変換色 0)同じ 1)変化",.75!,.75!,0:SYMBOL(51,107),"霧拭き範囲",.75!,.75!,0:SYMBOL(51,119),"アニメーションの間隔",.75!,.75!,0
  239. 2390 FOR A=0 TO 7:SYMBOL(220,A*12+35),"↓↑",.75!,.75!,0:SYMBOL(240,A*12+35),STR$(OP(A)),.75!,.75!,0:NEXT
  240. 2400 CX=MOUSE(0):CY=MOUSE(1)
  241. 2410 IF MOUSE(2,0)=0 THEN 2400
  242. 2420 IF CX>49 AND CX<62 AND CY>19 AND CY<31 THEN MOUSE 4,0,0,319,239:GOSUB *表示:SI=OP(0):FOR A=0 TO 1:SCREEN 1,A:PASTEL OP(1):NEXT:GOTO *MAIN
  243. 2430 IF CX>220 AND CX<244 AND CY>35 AND CY<131 THEN CX=INT((CX-220)/12):CY=INT((CY-35)/12) ELSE 2400
  244. 2440 OP(CY)=OP(CY)+CX*2-1:IF OP(0)<1 THEN OP(0)=1
  245. 2450 IF OP(7)<1 THEN OP(7)=1
  246. 2460 IF OP(7)>99 THEN OP(7)=99
  247. 2470 IF CY>0 AND CY<5 THEN OP(CY)=OP(CY)+CX*7:OP(CY)=INT(OP(CY)/8)*8
  248. 2480 IF OP(CY)<0 THEN OP(CY)=0
  249. 2490 IF OP(CY)>256 THEN OP(CY)=256
  250. 2500 IF OP(0)>64 THEN OP(0)=64
  251. 2510 IF OP(5)>1 THEN OP(5)=1
  252. 2520 LINE(240,CY*12+35)-(263,CY*12+46),PSET,7,BF:SYMBOL(240,CY*12+35),STR$(OP(CY)),.75!,.75!,0:WAIT 4
  253. 2530 GOTO 2400
  254. 2540 *ERRCD
  255. 2550 RESUME 2350
  256. 2560 *アニメ
  257. 2570 CC=0:A$="１":CCX=SI:CCY=SI
  258. 2580 SCREEN 1,1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF::SYMBOL(50,0),"ｱﾆﾒｰｼｮﾝする場所指定"+A$,.75!,.75!,7:SCREEN 1,0
  259. 2590 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOSUB *表示:GOTO *MAIN
  260. 2600 IF MOUSE(2,0)=0 THEN 2590
  261. 2610 IF CC=1 THEN 2670
  262. 2620 CCX=CX:CCY=CY:WAIT 20
  263. 2630 CX=INT(MOUSE(0)/SI)*SI-1:CY=INT(MOUSE(1)/SI)*SI-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOSUB *表示:GOTO *MAIN
  264. 2640 IF MOUSE(2,0)=0 THEN 2630
  265. 2650 GX=CCX:GY=CCY:CCX=CX-GX:CCY=CY-GY:A$="２":CC=1:IF INT((2*(CCX+1)*(CCY+1)+1)/2)>38400 THEN SE$="範囲が広すぎます｡指定を続行しますか":GOSUB *YN:IF QC=0 THEN 2570 ELSE GOSUB *W1:GOSUB *表示:GOTO *MAIN
  266. 2660 GOTO 2580
  267. 2670 SCREEN 1,0:CC!=INT((2*(CCX+1)*(CCY+1)+1)/2):GET@A(GX,GY)-(GX+CCX,GY+CCY),PIC:GET@A(CX,CY)-(CX+CCX,CY+CCY),PIC,CC!:SCREEN 1,1:CLS:LINE(159-(CCX+1)/2,119-(CCY+1)/2)-(160+(CCX+1)/2,120+(CCY+1)/2),PSET,7,BF
  268. 2680 PUT@A(160-(CCX+1)/2,120-(CCY+1)/2)-(159+(CCX+1)/2,119+(CCY+1)/2),PIC:WAIT OP(7)
  269. 2690 IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOSUB *表示:GOTO *MAIN
  270. 2700 PUT@A(160-(CCX+1)/2,120-(CCY+1)/2)-(159+(CCX+1)/2,119+(CCY+1)/2),PIC,,,,,CC!:WAIT OP(7)
  271. 2710 IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOSUB *表示:GOTO *MAIN
  272. 2720 GOTO 2680
  273. 2730 *編集
  274. 2740 QC=INT((CCY-12)/12)+1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,0:MOUSE 1,CX,CY,1:SCREEN 1,1:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0:WAIT 20:IF QC=3 OR QC=6 OR QC=7 THEN 2960 ELSE 2760
  275. 2750 SCREEN 1,1:SCREEN@1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:GOSUB *W1:GOSUB *表示:GOTO *MAIN
  276. 2760 IF QC=11 THEN *字
  277. 2770 IF QC=13 THEN *霧
  278. 2780 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:IF MOUSE(2,1)=-1 THEN 2750
  279. 2790 IF MOUSE(2,0)=0 THEN 2760
  280. 2800 CCX=CX:CCY=CY:WAIT 20
  281. 2810 CX=INT((MOUSE(0)+1)/SI)*SI-1:CY=INT((MOUSE(1)+1)/SI)*SI-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN 2750
  282. 2820 IF MOUSE(2,0)=0 THEN 2810
  283. 2830 IF QC=4 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO 2750
  284. 2840 IF QC=5 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],B:GOTO 2750
  285. 2850 GET@A(CCX,CCY)-(CX,CY),PIC:CHX=CCX:CHY=CCY:CCX=CX-CCX:CCY=CY-CCY:WAIT 20
  286. 2860 IF QC=9 THEN *拡大
  287. 2870 IF QC=8 THEN *反転
  288. 2880 IF QC=10 THEN *入替え
  289. 2890 IF QC=12 THEN *明るさ
  290. 2900 IF QC=14 THEN *混合
  291. 2910 IF QC=15 THEN *スプライト
  292. 2920 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,XOR:PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,XOR:IF MOUSE(2,1)=-1 THEN 2750
  293. 2930 IF MOUSE(2,0)=0 THEN 2920
  294. 2940 IF QC=1 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC:GOTO 2920
  295. 2950 IF QC=2 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,MATTE,,,[CO(0,0),CO(0,1),CO(0,2)]:GOTO 2920
  296. 2960 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 2750
  297. 2970 IF MOUSE(2,0)=0 THEN 2960
  298. 2980 IF QC=3 THEN PAINT@(CX,CY),[CO(C1,0),CO(C1,1),CO(C1,2)]:GOTO 2750
  299. 2990 CCX=CX:CCY=CY:WAIT 20:Y1=CO(C1,0):Y2=CO(C1,1):Y3=CO(C1,2)
  300. 3000 CX=ABS(CCY+CCX-MOUSE(0)-MOUSE(1)):CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3],,,,,XOR:CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3],,,,,XOR:IF MOUSE(2,1)=-1 THEN 2750
  301. 3010 IF MOUSE(2,0)=0 THEN 3000
  302. 3020 IF QC=6 THEN CIRCLE(CCX,CCY),CX,[CO(C1,0),CO(C1,1),CO(C1,2)]:GOTO 2750
  303. 3030 IF QC=7 THEN CIRCLE(CCX,CCY),CX,[CO(C1,0),CO(C1,1),CO(C1,2)],,,,F:GOTO 2750
  304. 3040 *拡大
  305. 3050 SCREEN 1,1:BA!=1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1
  306. 3060 MOUSE 1,,,0:PUT@A(0,0)-(CCX,CCY),PIC,,BA!,BA!:LINE(100,100)-(200,150),PSET,7,BF:SYMBOL(110,110),"倍率",.75!,.75!,0:SYMBOL(120,130),"↓",.75!,.75!,0:SYMBOL(180,130),"↑",.75!,.75!,0:MOUSE 1,,,1
  307. 3070 LINE(135,130)-(179,141),PSET,7,BF:SYMBOL(135,130),STR$(BA!),.75!,.75!,0
  308. 3080 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 3140
  309. 3090 IF MOUSE(2,0)=0 THEN 3080
  310. 3100 IF CY<130 OR CY>149 THEN 3080
  311. 3110 IF CX>120 AND CX<140 THEN BA!=BA!-.1!:IF BA!=0 THEN BA!=.1!
  312. 3120 IF CX>180 AND CX<200 THEN BA!=BA!+.1!
  313. 3130 GOTO 3060
  314. 3140 LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0
  315. 3150 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(CX+CCX*BA!,CY+CCY*BA!),XOR,7,B:LINE(CX,CY)-(CX+CCX*BA!,CY+CCY*BA!),XOR,7,B
  316. 3160 IF MOUSE(2,0)=0 THEN 3150
  317. 3170 PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,,BA!,BA!:GOTO 2750
  318. 3180 *反転
  319. 3190 SCREEN 1,1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:LINE(100,100)-(160,126),PSET,7,BF:SYMBOL(102,101),"上下反転",.75!,.75!,0:SYMBOL(102,113),"左右反転",.75!,.75!,0:MOUSE 4,100,100,160,125
  320. 3200 CY=INT((MOUSE(1)-100)/13):IF MOUSE(2,1)=-1 THEN 2750
  321. 3210 IF MOUSE(2,0)=0 THEN 3200
  322. 3220 MOUSE 1,,,0:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0:IF CY=1 THEN 3240
  323. 3230 FOR A=CCY TO 0 STEP -1:PUT@A(CHX,CHY+CCY-A)-(CHX+CCX,CHY+CCY-A),PIC,,,,,(CCX+1)*A:NEXT:GOTO 2750
  324. 3240 CC=CCY+1:FOR A=CCX TO 0 STEP -1:GET@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,(CCY+1)*CCX-CC*A:NEXT:FOR A=0 TO CCX:PUT@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,,,,,CC*A:NEXT:GOTO 2750
  325. 3250 *入替え
  326. 3260 MOUSE 1,,,0
  327. 3270 FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY
  328. 3280 C3=PEEK([&H1C]A*2+C*1024):C2=PEEK([&H1C]A*2+C*1024+1):B=INT(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT((INT(C2 AND 3)*64+INT(C3/8)*2)/8)*8
  329. 3290 C1=G-CO(0,0):C2=R-CO(0,1):C3=B-CO(0,2):IF ABS(C1)<=OP(2) AND ABS(C2)<=OP(3) AND ABS(C3)<=OP(4) THEN 
  330. 3300 IF OP(5)=0 THEN
  331. 3310 Y1=CO(1,0):Y2=CO(1,1):Y3=CO(1,2) 
  332. 3320 ELSE
  333. 3330 Y1=CO(1,0)+C1:Y2=CO(1,1)+C2:Y3=CO(1,2)+C3:Y1=-(Y1<256 AND Y1>0)*Y1-(Y1>255)*255:Y2=-(Y2<256 AND Y2>0)*Y2-(Y2>255)*255:Y3=-(Y3<256 AND Y3>0)*Y3-(Y3>255)*255
  334. 3340 ENDIF
  335. 3350 PSET(A,C),[Y1,Y2,Y3]
  336. 3360 ENDIF
  337. 3370 NEXT:NEXT:GOTO 2750
  338. 3380 *字
  339. 3390 MOUSE 1,,,0:SCREEN 0:LINE INPUT C$:IF C$="" OR C$=CHR$(13) THEN 2750
  340. 3400 PRINT "フォント番号":PRINT " 1)システム   12ﾄﾞｯﾄ":PRINT " 2)システム   16ﾄﾞｯﾄ":PRINT " 3)明朝体     24ﾄﾞｯﾄ":PRINT " 4)ゴシック体 24ﾄﾞｯﾄ"
  341. 3410 PRINT " 5)教科書体   24ﾄﾞｯﾄ":PRINT " 6)まるもじ   24ﾄﾞｯﾄ":PRINT " 7)明朝体     32ﾄﾞｯﾄ":PRINT " 8)ゴシック体 32ﾄﾞｯﾄ":PRINT " 9)明朝体     48ﾄﾞｯﾄ":PRINT "10)ゴシック体 48ﾄﾞｯﾄ":PRINT "11)毛筆体     48ﾄﾞｯﾄ"
  342. 3420 PRINT "12)明朝体     60ﾄﾞｯﾄ":PRINT "13)ゴシック体 60ﾄﾞｯﾄ"
  343. 3430 INPUT CC:IF CC<0 OR CC>13 THEN 3400
  344. 3440 ON CC GOTO 3450,3460,3470,3480,3490,3500,3510,3520,3530,3540,3550,3560,3570
  345. 3450 A$="システム   12ﾄﾞｯﾄ":GOTO 3580
  346. 3460 A$="システム   16ﾄﾞｯﾄ":GOTO 3580
  347. 3470 A$="明朝体     24ﾄﾞｯﾄ":GOTO 3580
  348. 3480 A$="ゴシック体 24ﾄﾞｯﾄ":GOTO 3580
  349. 3490 A$="教科書体   24ﾄﾞｯﾄ":GOTO 3580
  350. 3500 A$="まるもじ   24ﾄﾞｯﾄ":GOTO 3580
  351. 3510 A$="明朝体     32ﾄﾞｯﾄ":GOTO 3580
  352. 3520 A$="ゴシック体 32ﾄﾞｯﾄ":GOTO 3580
  353. 3530 A$="明朝体     48ﾄﾞｯﾄ":GOTO 3580
  354. 3540 A$="ゴシック体 48ﾄﾞｯﾄ":GOTO 3580
  355. 3550 A$="毛筆体     48ﾄﾞｯﾄ":GOTO 3580
  356. 3560 A$="明朝体     60ﾄﾞｯﾄ":GOTO 3580
  357. 3570 A$="ゴシック体 60ﾄﾞｯﾄ"
  358. 3580 ON ERROR GOTO *ERMJ:DEF FONT A$:ON ERROR GOTO 0
  359. 3590 C1=12:IF CC=2 THEN C1=16
  360. 3600 IF CC>2 AND CC<7 THEN C1=24
  361. 3610 IF CC=7 OR CC=8 THEN C1=32
  362. 3620 IF CC>7 AND CC<11 THEN C1=48
  363. 3630 IF CC>11 THEN C1=60
  364. 3640 SCREEN 1,0:MOUSE 0
  365. 3650 CX=INT(MOUSE(0)/SI)*SI:CY=INT(MOUSE(1)/SI)*SI:LINE(CX,CY)-(CX+LEN(C$)*C1/2,CY+C1),XOR,7,B:LINE(CX,CY)-(CX+LEN(C$)*C1/2,CY+C1),XOR,7,B
  366. 3660 IF MOUSE(2,0)=0 THEN 3650
  367. 3670 SYMBOL(CX,CY),C$,C1/16,C1/16,[CO(0,0),CO(0,1),CO(0,2)]
  368. 3680 IF MJC=1 THEN DEF FONT "システム   12ﾄﾞｯﾄ" ELSE DEF FONT "システム   16ﾄﾞｯﾄ"
  369. 3690 GOTO 2750
  370. 3700 *ERMJ
  371. 3710 BEEP:PRINT "このフォントは現在使用できません｡":RESUME 3400
  372. 3720 *明るさ
  373. 3730 SCREEN 1,1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:LINE(100,100)-(300,150),PSET,7,BF:SYMBOL(101,101),"明るさ 1で 同じ それ以上で明るく",.75!,.75!,0:BA!=1:SYMBOL(130,130),"↓",.75!,.75!,0:SYMBOL(200,130),"↑",.75!,.75!,0
  374. 3740 LINE(150,130)-(200,141),PSET,7,BF:SYMBOL(150,130),STR$(BA!),.75!,.75!,0
  375. 3750 CX=MOUSE(0)-130:CY=MOUSE(1)-130:IF MOUSE(2,1)=-1 THEN 3810
  376. 3760 IF MOUSE(2,0)=0 THEN 3750
  377. 3770 IF CY<0 OR CY>19 OR CX<0 THEN 3750
  378. 3780 IF CX<20 THEN BA!=BA!-.1!:IF BA!<.1! THEN BA!=.1!
  379. 3790 IF CX>70 AND CX<90 THEN BA!=BA!+.1!
  380. 3800 GOTO 3740
  381. 3810 SCREEN 1,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:C3=PEEK([&H1C]A*2+C*1024):C2=PEEK([&H1C]A*2+C*1024+1):B=INT(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT((INT(C2 AND 3)*64+INT(C3/8)*2)/8)*8
  382. 3820 Y1=G*BA!:Y2=R*BA!:Y3=B*BA!:Y1=-(Y1<256)*Y1-(Y1>255)*255+(Y1=0)*(BA!>1)*8:Y2=-(Y2<256)*Y2-(Y2>255)*255+(Y2=0)*(BA!>1)*8:Y3=-(Y3<256)*Y3-(Y3>255)*255+(Y3=0)*(BA!>1)
  383. 3830 PSET(A,C),[Y1,Y2,Y3]:NEXT:NEXT
  384. 3840 SCREEN 1,1:SE$="元の絵に戻しますか｡":GOSUB *YN:IF QC=0 THEN SCREEN 1,0:PUT@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC
  385. 3850 GOTO 2750
  386. 3860 *霧
  387. 3870 CC=OP(6):C2=SQR(CC)
  388. 3880 CX=MOUSE(0):CY=MOUSE(1)
  389. 3890 IF MOUSE(2,1)=-1 THEN PASTEL OP(1):GOTO 2750
  390. 3900 IF MOUSE(2,0)=0 THEN 3880
  391. 3910 MOUSE 1,,,0:FOR A=0 TO (CC+3)/3:CCX=INT(RND*CC-CC/2):CCY=INT(RND*CC-CC/2):C1=INT(255-C2*SQR(CCX^2*CCY^2)):C1=-(C1>8)*C1-(C1<9)*8:PASTEL C1:PSET(CX+CCX,CY+CCY),[CO(0,0),CO(0,1),CO(0,2)],PASTEL:NEXT
  392. 3920 MOUSE 1,,,1:GOTO 3880
  393. 3930 *混合
  394. 3940 LINE(CHX,CHY)-(CHX+CCX,CHY+CCY),PASTEL,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO 2750
  395. 3950 *スプライト
  396. 3960 MOUSE 1,,,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:C3=PEEK([&H1C]A*2+C*1024):C2=PEEK([&H1C]A*2+C*1024+1):B=INT(C3 AND 31):G=((C2 AND 127)-(C2 AND 3)):R=INT((INT(C2 AND 3)*64+INT(C3/8)*2)/8)
  397. 3970 IF B=0 AND G=0 AND R=0 THEN PSET(A,C),[0,0,0,1]
  398. 3980 NEXT:NEXT:GOTO 2750
  399.